home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
mdishe
/
ctl3d.bas
< prev
next >
Wrap
BASIC Source File
|
1994-12-26
|
3KB
|
67 lines
' Ctl3D.Bas - Control 3D Start and End
' 94/08/11 Copyright 1994, Larry Rebich, The Bridge, Inc.
' Start by calling Ctl3D_Start
' End by calling Ctl3D_End
'--------------------------------------------------------
Option Explicit
DefInt A-Z
Declare Function GetWindowWord Lib "User" (ByVal hWnd As Integer, ByVal nIndex As Integer) As Integer
Declare Function Ctl3DAutoSubclass Lib "Ctl3Dv2.DLL" (ByVal hInst As Integer) As Integer
Declare Function Ctl3DRegister Lib "Ctl3Dv2.DLL" (ByVal hInst As Integer) As Integer
Declare Function Ctl3DUnregister Lib "Ctl3Dv2.DLL" (ByVal hInst As Integer) As Integer
' Declare Function Ctl3DAutoSubclass Lib "Ctl3D.DLL" (ByVal hInst As Integer) As Integer
' Declare Function Ctl3DRegister Lib "Ctl3D.DLL" (ByVal hInst As Integer) As Integer
' Declare Function Ctl3DUnregister Lib "Ctl3D.DLL" (ByVal hInst As Integer) As Integer
Const GWW_HINSTANCE = (-6)
Dim Ctl3D_Open As Integer 'set to true if open
Sub Ctl3D_End ()
Dim inst, ret
Rem This Sub is used to end the 3D effects
Rem IMPORTANT: you must end 3D effects before your app ends
If Not Ctl3D_Open Then Exit Sub 'not open, so forget it
inst = GetWindowWord(Forms(0).hWnd, GWW_HINSTANCE) 'Get the Word of Frm
ret = Ctl3DUnregister(inst) ' Unregister the program.
Ctl3D_Open = False
End Sub
Sub Ctl3D_Start ()
' Use this to start the 3D dialogs
If Ctl3D_Open Then Exit Sub 'already registered
If Not DoesCtl3DExist() Then Exit Sub 'can't find it
If Forms.Count = 0 Then
Dim Msg As String
Msg = "There is no loaded form. "
Msg = Msg & "To register your app with CTL3D "
Msg = Msg & "there must be at least one loaded form. "
Msg = Msg & Chr$(13) & Chr$(13)
Msg = Msg & "Use the Load statement to load a form, "
Msg = Msg & "use Ctl3D_Start, then unload the form."
MsgBox Msg, 48, "No Form Loaded"
Exit Sub
End If
Dim inst, ret
inst = GetWindowWord(Forms(0).hWnd, GWW_HINSTANCE) 'Get the Word from Frm
ret = Ctl3DRegister(inst) ' Register program w/ Ctl3d.
ret = Ctl3DAutoSubclass(inst) ' Subclass the program.
Ctl3D_Open = True
End Sub
Function DoesCtl3DExist ()
' Call this function to check for the existance of Ctl3Dv2.Dll on the user's system
Dim Fn As String
Fn = "Ctl3Dv2.Dll" 'can it be found?
'Fn = "Ctl3Dv2.Dlx" 'for testing, bad name
If Not bFileExists(Fn) Then
DoesCtl3DExist = True
Else
DoesCtl3DExist = False
End If
End Function